home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / xlisp_21.zoo / xl-002.bug < prev    next >
Internet Message Format  |  1990-02-28  |  9KB
  1. From sce!mitel!uunet!cs.utexas.edu!tut.cis.ohio-state.edu!unmvax!ogccse!blake!uw-beaver!tektronix!zephyr.ens.tek.com!tekcrl!tekgvs!toma Tue Aug 29 08:42:34 EDT 1989
  2. Article: 139 of comp.lang.lisp.x
  3. Path: cognos!sce!mitel!uunet!cs.utexas.edu!tut.cis.ohio-state.edu!unmvax!ogccse!blake!uw-beaver!tektronix!zephyr.ens.tek.com!tekcrl!tekgvs!toma
  4. From: toma@tekgvs.LABS.TEK.COM (Tom Almy)
  5. Newsgroups: comp.lang.lisp.x
  6. Subject: Some Xlisp 2.0 read/print bugs
  7. Message-ID: <5818@tekgvs.LABS.TEK.COM>
  8. Date: 24 Aug 89 15:44:30 GMT
  9. Reply-To: toma@tekgvs.LABS.TEK.COM (Tom Almy)
  10. Organization: Tektronix, Inc., Beaverton,  OR.
  11. Lines: 262
  12. Posted: Thu Aug 24 08:44:30 1989
  13.  
  14. I discovered these problems with characters, strings, and symbols while 
  15. working on some Common Lisp-like enhancements.
  16.  
  17. (I will post the enhancements when finished.  These include COERCE, 
  18. CONCATENATE, and enhancements to functions that CL states take sequence
  19. arguments (lists, arrays, or strings in XLISP case) which XLISP implements
  20. typically only for lists (except for SUBSEQ which only works on strings).
  21.  
  22.  
  23. Problem: Uninterned symbols do not print with leading #:
  24. Example: (GENSYM)
  25. Fix:
  26.  
  27. 1) At the beginning of xlprint, replace the code to print NIL with:
  28.  
  29.     /* print nil */
  30.     if (vptr == NIL) {
  31.         xlputstr(fptr,
  32.             (((!flag) || (getvalue(s_printcase) != k_downcase))?"NIL":"nil"));
  33.         return;
  34.     }
  35.  
  36. 2) In putsymbol, add these declarations:
  37.  
  38.     int i;
  39.     LVAL sym,array;
  40.  
  41. 3> In putsymbol, add the following *after* the code section titled "check
  42.    for printing without escapes":
  43.  
  44.     /* check for uninterned symbol */
  45.     i = hash(str,HSIZE);
  46.     array = getvalue(obarray);
  47.     for (sym = getelement(array,i);sym; sym = cdr(sym))
  48.         if (strcmp(str,(char*)getstring(getpname(car(sym)))) == 0)
  49.             goto internedSymbol;
  50.     
  51.     xlputc(fptr,'#');   /* indicate uninterned */
  52.     xlputc(fptr,':');
  53.  
  54. internedSymbol:         /* sorry about the "goto" */
  55.  
  56.  
  57. *******************************************************************
  58.  
  59. Problem: strings containing nulls cannot be read or printed.
  60. (Note, strcat has the same problem, but I have a new version, the
  61.  Common Lisp CONCATENATE function, which will replace it.
  62.  
  63.  
  64. Example: Enter "A string\000will forget these"
  65.  
  66. Fix: 
  67.  
  68. 1) In rmdquote change section "check for buffer overflow" to:
  69.  
  70.     if (blen >= STRMAX) {
  71.         newstr = newstring(len + STRMAX + 1);
  72.         sptr = getstring(newstr); 
  73.         if (str) memcpy((char *)sptr,(char *)getstring(str),len);
  74.         *p = '\0'; 
  75.         memcpy((char *)sptr+len,(char *)buf,blen+1);
  76.         p = buf; 
  77.         blen = 0;
  78.         len += STRMAX;
  79.         str = newstr;
  80.     }
  81.  
  82. 2) In rmdquote, change section "append the last substring" to:
  83.  
  84.     if (str == NIL || blen) {
  85.         newstr = newstring(len + blen + 1);
  86.         sptr = getstring(newstr);
  87.         if (str) memcpy((char *)sptr,(char *)getstring(str),len);
  88.         *p = '\0'; 
  89.         memcpy((char *)sptr+len,(char *)buf,blen+1);
  90.         str = newstr;
  91.     }
  92.  
  93. 3) New versions of putstring and putqstring
  94.  
  95.  
  96. /* putstring - output a string */
  97. /* rewritten to  print strings containing nulls TAA mod*/
  98. LOCAL VOID putstring(fptr,str)
  99.   LVAL fptr,str;
  100. {
  101.     unsigned char* p = getstring(str);
  102.     int len = getslength(str) - 1;
  103.  
  104.     /* output each character */
  105.     while (len-- > 0) xlputc(fptr,*p++);
  106. }
  107.  
  108. /* putqstring - output a quoted string */
  109. /* rewritten to  print strings containing nulls TAA mod*/
  110. LOCAL VOID putqstring(fptr,str)
  111.   LVAL fptr,str;
  112. {
  113.     unsigned char* p = getstring(str);
  114.     int len = getslength(str) - 1;
  115.     int ch;
  116.  
  117.     /* output the initial quote */
  118.     xlputc(fptr,'"');
  119.  
  120.     /* output each character in the string */
  121.     while (len-- > 0) {
  122.         ch = *p++;
  123.  
  124.         /* check for a control character */
  125.         if (ch < 040 || ch == '\\' || ch > 0176) {
  126.             xlputc(fptr,'\\');
  127.             switch (ch) {
  128.                 case '\011':
  129.                     xlputc(fptr,'t');
  130.                     break;
  131.                 case '\012':
  132.                     xlputc(fptr,'n');
  133.                     break;
  134.                 case '\014':
  135.                     xlputc(fptr,'f');
  136.                     break;
  137.                 case '\015':
  138.                     xlputc(fptr,'r');
  139.                     break;
  140.                 case '\\':
  141.                     xlputc(fptr,'\\');
  142.                     break;
  143.                 default:
  144.                     putoct(fptr,ch);
  145.                     break;
  146.             }
  147.         }
  148.  
  149.         /* output a normal character */
  150.         else
  151.             xlputc(fptr,ch);
  152.     }
  153.  
  154.  
  155.     /* output the terminating quote */
  156.     xlputc(fptr,'"');
  157. }
  158.  
  159.  
  160. ********************************************
  161.  
  162. Problem: Control and meta characters print "raw" with prin1.
  163.  
  164. Example: Execute (int-char 7)
  165.  
  166. Fix: New version of putchcode:
  167.  
  168. /* putchcode - output a character */
  169. /* modified to print control and meta characters TAA Mod */
  170. /* Format: #\[M-][C-]c
  171.    Where "M-" denotes character is meta character (value > 127).
  172.          "C-" denotes character is control character ( value modulo 128 < 32)
  173.    and "c" is either a printing character or "Space", "Newline", or "Rubout".
  174. */
  175.  
  176.  
  177. LOCAL VOID putchcode(fptr,ch,escflag)
  178.   LVAL fptr; int ch,escflag;
  179. {
  180.     if (escflag) {
  181.         xlputstr(fptr,"#\\");
  182.         if (ch > 127) {
  183.             ch -= 128;
  184.             xlputstr(fptr,"M-");
  185.         }
  186.         switch (ch) {
  187.             case '\n':
  188.                 xlputstr(fptr,"Newline");
  189.                 break;
  190.             case ' ':
  191.                 xlputstr(fptr,"Space");
  192.                 break;
  193.             case 127:
  194.                 xlputstr(fptr,"Rubout");
  195.                 break;
  196.             default:
  197.                 if (ch < 32) {
  198.                     ch += '@';
  199.                     xlputstr(fptr,"C-");
  200.                 }
  201.                 xlputc(fptr,ch);
  202.                 break;
  203.         }
  204.     }
  205.     else xlputc(fptr,ch);
  206. }
  207.  
  208. *******************************************
  209.  
  210. Problem: Inability to declare character literals for control and meta
  211.  characters.
  212.  
  213. Fix: in rmhash(), first add declaration "int i", then 
  214.      change case '\\' code to:
  215.  
  216.     case '\\':
  217.         for (i = 0; i < STRMAX-1; i++) {
  218.             if ((tentry(buf[i] = checkeof(fptr))  != k_const) &&
  219.                 buf[i] != '\\' && buf[i] != '|') {
  220.                 xlungetc(fptr, buf[i]);
  221.                 break;
  222.             }
  223.         }
  224.         buf[i] = 0;
  225.  
  226.         ch = buf[0];
  227.         if (strlen(buf) > 1) {
  228.             upcase(buf);
  229.             bufp = &buf[0];
  230.             ch = 0;
  231.             if (strncmp(bufp,"M-",2) == 0) {
  232.                 ch = 128;
  233.                 bufp += 2;
  234.             }
  235.             if (strcmp(bufp,"NEWLINE") == 0)
  236.                 ch += '\n';
  237.             else if (strcmp(bufp,"SPACE") == 0)
  238.                 ch += ' ';
  239.             else if (strcmp(bufp,"RUBOUT") == 0)
  240.                 ch += 127;
  241.             else if (strlen(bufp) == 1) 
  242.                 ch += *bufp;
  243.             else if (strncmp(bufp,"C-",2) == 0 && strlen(bufp) == 3) 
  244.                 ch += bufp[2] & 31;
  245.             else xlerror("unknown character name",cvstring(buf));
  246.         }
  247.         rplaca(val,cvchar(ch));
  248.         break;
  249.  
  250. ***********************************************
  251.  
  252. Problem: Invalid symbols can be created with intern and make-symbol.
  253.     Also, you can make NIL, which is highly irregular.
  254.  
  255. Example: (intern "abc\017def")  (intern "NIL")
  256.  
  257.  
  258. Fix: Add to makesymbol(), before section "make the symbol":
  259.  
  260.     /* check for making "NIL" -- very bad */
  261.     if (strcmp((char *)getstring(pname),"NIL") == 0)
  262.         xlerror("you've got to be kidding!");
  263.  
  264.     /* check for containing only printable characters */
  265.     i = getslength(pname)-1;
  266.     while (i-- > 0) if (((signed char)(pname->n_string[i])) < 32 )
  267.         xlerror("string contains non-printing characters",pname);
  268.     
  269.  
  270.  
  271. *****************
  272.  
  273. Tom Almy
  274. toma@tekgvs.labs.tek.com
  275. Standard Disclaimers Apply
  276.  
  277.  
  278. From sce!mitel!uunet!zephyr.ens.tek.com!tekcrl!tekgvs!toma Tue Aug 29 11:30:44 EDT 1989
  279. Article: 140 of comp.lang.lisp.x
  280. Path: cognos!sce!mitel!uunet!zephyr.ens.tek.com!tekcrl!tekgvs!toma
  281. From: toma@tekgvs.LABS.TEK.COM (Tom Almy)
  282. Newsgroups: comp.lang.lisp.x
  283. Subject: Yet Another XLISP Bug
  284. Message-ID: <5824@tekgvs.LABS.TEK.COM>
  285. Date